C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C       Toolpack POLISH-77: a Fortran-77 pretty-printer.
C
C       Programmed by Malcolm Cohen, NAG, June 1984 (Version 0.1)
C
C       Revised July-August 1984
C           (Version 0.2)
C       Revised November-December 1984
C           (for Toolpack/1 version 1.1)
C       Revised September 1985
C           (for Toolpack/1 version 2.1)
C
C       Step 1    Produce compilable output using an extensible framework
C       Step 1.5  Make the continuation character programmable
C       Step 2    Add table-driven token spacing
C       Step 2.5  Detect labels and format them as required
C       Step 2.6  Separate monadic plus/minus tokens from binary
C       Step 3    Indentation
C       Step 3.5  Intelligent line breaking
C       Step 4    Blank line insertion
C       Step 5    Sequence numbering
C       Step 6    Statement re-labelling
C       Step 7    Move FORMAT statements
C       Step 8    Ensure DO-loops end on unique CONTINUE statements
C       Step 9    Comment processing
C       Step 9.5  Case conversion
C       Step 10   Parameter input
C       Step 10.5 Process Source-Embedded Directives
C       Step 11   Simple-minded assignment line-up capability (V1)
C       Step 12   Declaration body line-up capability (V1.0)
C       Step 13   Progress trace facility (V1.0)
C       Step 14   Add incremental parameter setting (V1.1)
C       Step 15   Add even more options (INDDOC,DELSED,BRKLIF) (V1.1)
C       Step 16   Additional options for V2.1
C
C ****************************************
C *
C * As of step 16, parameters are:
C * ------------------------------
C * LMARGS,RMARGS: Margin control (statements)
C * LMARGC,RMARGC: Margin control (comments)
C * CONCHR: Continuation line character control
C * SPBEF,SPAFT: Token spacing
C * LABELF: Label format control
C * LABELC: Label starting column
C * INDDO,INDIF,INDCON: Indentation amounts
C * INDCMT: Indentation control for comments
C * BRPRIO: Breakage priority for each token/parenlevel
C * BLBEF,BLAFT,BLADEC,BLCHAR: Blank line insertion
C * SEQRQD,SEQINI,SEQINC,SEQDIG,SEQFIL: Sequence numbering
C * FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM: Relabelling
C * MOVEF: Move FORMAT statements switch
C * DOCONI: DO-loop CONTINUE insertion
C * IOTHCO: Insertion of Other CONTINUE statements
C * CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR: Comment processing
C * KWCASE,IDCASE,STRCAS,CMCASE,FFCASE: Case conversion
C * VLEN: Variable length for assignment line-up
C * DLEN,DLUP: Declaration keyword length and body line-up
C * TRACE: Trace progress
C * INDDOC: Indent DO-loop CONTINUEs
C * DELSED: Delete source-embedded directives for ISTPL
C * BRKLIF: Break logical IF statements after condition
C * ERRCMT: Insert error messages into program as comments
C * CVTHFM: Convert H-edit descriptors to character strings
C * FFCASE: Case of format field descriptors
C * RMOPCF: Optional comma removal in FORMAT statements
C * SEQDIG: Number of digits in sequence numbers
C * SEQFIL: Fill character for sequence numbers
C * FMSBRK: Break strings nicely in FORMAT statements
C *
C ****************************************
 
C ****************************************
C *
C * Other Variables:
C * ----------------
C * MAXIND  -  Maximum indentation value (2/3rds along the line)
C *
C ****************************************
 
C ****************************************
C *
C * State Variables:
C * ----------------
C * LABEL         Label of current statement
C * FSTTOK        First (non-label) token of current statement
C * LASTST        First token of last statement
C * LASTTK        Token before current
C * CONCOL        Column for a continuation line to begin on, or 0
C * DOLVL         DO-loop nexting level
C * IFLVL         block-IF nesting level
C * DOLBL(n)      Ending label of DO-loop at nesting level n
C * BRKPOS        Best position to break line at or 0
C * BRKPRI        Priority of that position (ie how good it is)
C * MINBRK        Minimum break position (halfway along the line)
C * LNUMBR        Line number (for sequence numbers and error messages)
C * FLBNUM        Next FORMAT statement label (when relabelling)
C * SLBNUM        Next executable statement label (ditto)
C * LBLUNK        Number of currently unknown labels (ref'ed but not defined)
C * LBLTBI        Table of labels in input (when relabelling)
C * LBLTBO        Corresponding labels for output (ditto)
C * LBLTOP        Highest used element of LBLTBI/LBLTBO
C * BEGUN         We have actually started outputting source code
C *               for the current program unit (as vs. comments)
C * BEGCMT        There are comments at the beginning of the program unit
C *               which have not yet been written to the output file
C *
C * Also: (ie not in /STATE/ but still that sort of variable:
C *
C * PUNAME        Program unit name (for seq numbers and err messages)
C * CONCNT        Number of continuation lines of current statement
C * NDOCON        Number of CONTINUEs added to DO-loops due to duplicate
C *               ending labels
C * DOCONS(n)     New internal label number for ending DO-loop at nesting
C *               level n, or 0.
C * DLUPOS        Declaration line-up position
C * MFFLAG        => We actually do have FORMAT statements to move
C *
C ****************************************
C
C ------------------------------------------------------------------------
C
C       P O L I S H   -   Polish a single statement
C
 
        SUBROUTINE POLISH(NOTDON)
        LOGICAL NOTDON
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TYPES/ STTYPE
        INTEGER STTYPE(TKLAST)
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        INTEGER I
 
        SAVE
 
        INTEGER CTOI
        EXTERNAL CTOI,ERROR
 
        PRNLVL=0
        LABEL=0
        IF (TOKTYP.EQ.TZEOF) THEN
            IF (LASTST.NE.TEND) CALL PLERR('Missing END statement')
            CALL POLFIN
            TOKTYP=0
            NOTDON = .FALSE.
            RETURN
        ELSE IF (TOKTYP.EQ.0) THEN
            CALL ERROR('POLISH called after end of program')
        END IF
        NOTDON = .TRUE.
 
        IF (TOKTYP.EQ.TDCNST) THEN
            I=1
            LABEL=CTOI(TOKTXT,I)
 100        CALL RDTOK
            IF (TOKTYP.EQ.TCMMNT) THEN
                CALL PLERR('Embedded comment after label moved')
                CALL OUTCMT
                GOTO 100
            END IF
        ENDIF
        FSTTOK=TOKTYP
        IF (TOKTYP.EQ.TEND) THEN
            IF (NXTTYP.NE.TZEOS)
     +          CALL PLERR('Invalid END statement')
            CALL PROEND
            LASTST=FSTTOK
        ELSE
            IF (STTYPE(TOKTYP).EQ.1) THEN
                CALL PROCMT
            ELSE IF (STTYPE(TOKTYP).EQ.2) THEN
                CALL PROFMT
            ELSE IF (STTYPE(TOKTYP).EQ.3) THEN
                CALL PRODEC
            ELSE IF (STTYPE(TOKTYP).EQ.4) THEN
                CALL PROEXE
            ELSE
                CALL PLERR('Unexpected statement type')
            END IF
            CALL PROEOS
            LASTST=FSTTOK
        END IF
 
        END
C ------------------------------------------------------------------------
C
C       P L O P T F  -  Read and obey a polish option file
C
 
        SUBROUTINE PLOPTF(IODOPT)
        INTEGER IODOPT
 
        INTEGER OPTLEN,OPT(134),I
 
        INTEGER ZGTCMD
        EXTERNAL ZGTCMD
 
        IF (IODOPT.NE.-1) THEN
 100        OPTLEN=ZGTCMD(OPT,IODOPT)
            IF (OPTLEN.NE.-100) THEN
                CALL POLOPT(OPT,.FALSE.)
                GOTO 100
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       T M P F I L   -   Create a temporary file
C
 
        INTEGER FUNCTION TMPFIL(PATH)
        INTEGER PATH(81)
 
        INTEGER CREATE
        EXTERNAL CREATE,ZITOCP
 
        INTEGER TMPNUM
 
        TMPFIL=CREATE(PATH,2)
        IF (TMPFIL.NE.-1) RETURN
        TMPNUM=0
 100    CALL ZITOCP(TMPNUM,PATH(4),3,48)
        PATH(7)=46
        TMPFIL=CREATE(PATH,2)
        IF (TMPFIL.EQ.-1 .AND. TMPNUM.LT.999) THEN
            TMPNUM=TMPNUM+1
            GOTO 100
        ELSE IF (TMPNUM.EQ.999) THEN
            CALL ERROR('Can''t create temporary scratch file')
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       I N I P O L  -  Initialise polish variables
C
 
        SUBROUTINE INIPOL(INDESC,POLFD)
        INTEGER INDESC,POLFD
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/CONTIN/CONCHR,CONCNT
        INTEGER CONCHR,CONCNT
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/MOVFMT/MOVEF,MFFLAG
        LOGICAL MOVEF,MFFLAG
 
        COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
        LOGICAL DOCONI,IOTHCO
        INTEGER NDOCON,DOCONS(30)
 
        COMMON/ERTEST/NERROR
        INTEGER NERROR
 
        COMMON/NAME/PUNAME
        CHARACTER*6 PUNAME
 
        COMMON/DECLUP/DLUP,DLEN,DLUPOS
        LOGICAL DLUP
        INTEGER DLEN,DLUPOS
 
        COMMON/OPT15C/INDDOC,DELSED,BRKLIF
        LOGICAL INDDOC,DELSED,BRKLIF
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
        INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
 
        COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
        INTEGER FLBINI,FLBINC,SLBINI,SLBINC
        LOGICAL RLBFMT,RLBSTM
 
        SAVE
 
        COMMON/SCRATC/RLBPTH,FMTPTH,SCRPTH
        INTEGER RLBPTH(81),FMTPTH(81),SCRPTH(81)
 
        INTEGER TMPFIL
 
        EXTERNAL ERROR
 
        MAXIND=(LMARGS+RMARGS*2)/3
 
C Check some consistency things
 
        IF (CMMODE.EQ.2) THEN
            IF (SEQRQD) CALL REMARK(
     +'Warning: sequence numbering applied to verbatim comment lines')
            CBOX=0
            CMCHAR=32
            INDCMT=.FALSE.
        END IF
        IF (RMARGC.GT.72 .AND. SEQRQD)
     +    CALL ERROR('RMARGC > 72, a'//'nd sequence numbers requested')
        IF (DOCONI .AND. .NOT. RLBSTM)
     +      CALL ERROR('DOCONI a'//'nd n'//'ot RLBSTM')
        IF (INDDOC .AND. .NOT. DOCONI)
     +      CALL ERROR('INDDOC a'//'nd n'//'ot DOCONI')
        IF (LMARGS.GT.RMARGS)
     +      CALL ERROR('LMARGS is great'//'er than RMARGS')
 
C Assign file descriptors
 
        TKDESC=INDESC
        IODPOL=POLFD
 
C Open temporary files
 
        IF (RLBSTM .OR. RLBFMT) IODRLB=TMPFIL(RLBPTH)
        IF (MOVEF) IODFMT=TMPFIL(FMTPTH)
        IF (SEQRQD .OR. CBOX.GT.0) IODSCR=TMPFIL(SCRPTH)
 
C Initialise state variables
 
        IODCUR=IODPOL
        DO 100 CURSOR=1,132
            LINE(CURSOR)=32
 100    CONTINUE
        CURSOR=1
        CONCNT=0
        CONCOL=0
        DOLVL=0
        IFLVL=0
        BRKPOS=0
        BRKPRI=0
        LASTST=TEND
        PUNAME='MAIN  '
        LNUMBR=SEQINI
        LBLTOP=0
        LBLUNK=0
        FLBNUM=-1
        SLBNUM=-1
        NDOCON=0
        NERROR=0
        DLUPOS=0
        MFFLAG=.FALSE.
        BEGUN=.FALSE.
        BEGCMT=.FALSE.
 
C Initialise buffered input
 
        TOKTYP=0
        NXTTYP=0
        NXTLEN=0
        NXTTXT(1)=129
        CALL RDTOK
        CALL RDTOK
 
        END
C ----------------------------------------------------------------------
C
C       P L S F N B   -   Polish Scratch File Name Blockdata
C
 
        BLOCK DATA PLSFNB
 
        COMMON/SCRATC/RLBPTH,FMTPTH,SCRPTH
        INTEGER RLBPTH(81),FMTPTH(81),SCRPTH(81)
 
        INTEGER I
 
        SAVE
 
        DATA (RLBPTH(I),I=1,11)/112,111,108,114,108,98,
     +          46,116,109,112,129/
     +       (FMTPTH(I),I=1,11)/112,111,108,102,109,116,
     +          46,116,109,112,129/
     +       (SCRPTH(I),I=1,11)/112,111,108,115,99,114,
     +          46,116,109,112,129/
 
        END
C ----------------------------------------------------------------------
C
C       P O L F I N   -   Tidy up after finishing the polish
C
 
        SUBROUTINE POLFIN
 
        COMMON/SCRATC/RLBPTH,FMTPTH,SCRPTH
        INTEGER RLBPTH(81),FMTPTH(81),SCRPTH(81)
 
        COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
        INTEGER FLBINI,FLBINC,SLBINI,SLBINC
        LOGICAL RLBFMT,RLBSTM
 
        COMMON/MOVFMT/MOVEF,MFFLAG
        LOGICAL MOVEF,MFFLAG
 
        COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
        INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        SAVE
 
        EXTERNAL REMOVE,CLOSE
 
        IF (RLBSTM .OR. RLBFMT) THEN
            CALL CLOSE(IODRLB)
            CALL REMOVE(RLBPTH)
        END IF
        IF (MOVEF) THEN
            CALL CLOSE(IODFMT)
            CALL REMOVE(FMTPTH)
        END IF
        IF (SEQRQD .OR. CBOX.GT.0) THEN
            CALL CLOSE(IODSCR)
            CALL REMOVE(SCRPTH)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       R D T O K  -  Read token (via lookahead buffer)
C
 
        SUBROUTINE RDTOK
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
C This parameter is the maximum sized token we want to ever receive
        INTEGER MAXL
        PARAMETER (MAXL = 1322 - 4)
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/XTTYPE/TMPLUS,TMMINU
        INTEGER TMPLUS,TMMINU
 
        COMMON/OPT15C/INDDOC,DELSED,BRKLIF
        LOGICAL INDDOC,DELSED,BRKLIF
 
        COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
        INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
 
        COMMON/CVTOPT/CVTHFM,FMSBRK
        LOGICAL CVTHFM,FMSBRK
 
        COMMON/REMTOK/RMOPCF
        LOGICAL RMOPCF
 
        SAVE
 
        INTEGER I,STATUS,BIND,ID(3),TEXT(1322)
        LOGICAL SEDDEL
 
        INTEGER ZSEDID,LENGTH,ZTOKTX
        EXTERNAL SCOPY,ZGETTK,ERROR,ZSEDID,ZTOKTX,LENGTH
 
 100    SEDDEL=.FALSE.
        LASTTK=TOKTYP
        TOKTYP=NXTTYP
        TOKLEN=NXTLEN
        CALL SCOPY(NXTTXT,1,TOKTXT,1)
        IF (TOKTYP.EQ.TCMMNT) THEN
            IF (CMMODE.EQ.3 .AND. TOKLEN.GT.0) THEN
                TOKLEN=MIN(TOKLEN,72)
 200            IF (TOKTXT(TOKLEN).EQ.32) THEN
                    TOKLEN=TOKLEN-1
                    IF (TOKLEN.GT.0) GOTO 200
                END IF
                TOKTXT(TOKLEN+1)=129
            END IF
            IF (ZSEDID(TOKTXT,BIND,ID,TEXT).EQ.-2) THEN
                IF (ID(1).EQ.112 .AND. ID(2).EQ.108) THEN
                    CALL POLOPT(TEXT,.TRUE.)
                    SEDDEL=DELSED
                END IF
            END IF
        END IF
        IF (TOKTYP.NE.TZEOF) THEN
            CALL ZGETTK(NXTTYP,NXTLEN,NXTTXT,TKDESC,STATUS)
            IF (NXTLEN .GT. MAXL)
     +          CALL ERROR('Token too long, recovery impossible')
            IF (STATUS.EQ.-1) CALL ERROR('Token Read Failed')
            IF (STATUS.EQ.-100) CALL ERROR('Incomplete token file')
 
            IF (RMOPCF .AND. FSTTOK.EQ.TFORMA .AND.
     +          NXTTYP.EQ.TCOMMA .AND. (TOKTYP.EQ.TSLASH .OR.
     +          TOKTYP.EQ.TCOLON)) THEN
                CALL ZGETTK(NXTTYP,NXTLEN,NXTTXT,TKDESC,STATUS)
                IF (NXTLEN .GT. MAXL)
     +              CALL ERROR('Token too long, recovery impossible')
                IF (STATUS.EQ.-1) CALL ERROR('Token Read Failed')
                IF (STATUS.EQ.-100) CALL ERROR('Incomplete token file')
            END IF
 
            IF (NXTTYP.EQ.THCNST .AND. FSTTOK.EQ.TFORMA .AND. CVTHFM)
     +          NXTTYP=TCCNST
            STATUS=ZTOKTX(NXTTYP,NXTLEN,NXTTXT,TEXT)
            CALL CASCVT(NXTTYP,NXTLEN,TEXT)
            NXTLEN=LENGTH(TEXT)
            IF (NXTLEN.GT.0) THEN
                IF (TEXT(NXTLEN).EQ.32 .AND. NXTTYP.NE.THCNST) THEN
                    TEXT(NXTLEN)=129
                    NXTLEN=NXTLEN-1
                END IF
            END IF
            CALL SCOPY(TEXT,1,NXTTXT,1)
 
C "+" & "-" are binary iff last token was ")", <name>, or <number>
 
            IF (.NOT.(TOKTYP.EQ.TRPARN .OR. TOKTYP.EQ.TNAME .OR.
     +           TOKTYP.EQ.TDCNST .OR. TOKTYP.EQ.TRCNST .OR.
     +           TOKTYP.EQ.TPCNST) .AND. NXTTYP.EQ.TPLUS) THEN
                NXTTYP=TMPLUS
                NXTLEN=1
                NXTTXT(1)=43
                NXTTXT(2)=129
            ELSE IF (.NOT.(TOKTYP.EQ.TRPARN .OR. TOKTYP.EQ.TNAME .OR.
     +           TOKTYP.EQ.TDCNST .OR. TOKTYP.EQ.TRCNST .OR.
     +           TOKTYP.EQ.TPCNST) .AND. NXTTYP.EQ.TMINUS) THEN
                NXTTYP=TMMINU
                NXTLEN=1
                NXTTXT(1)=45
                NXTTXT(2)=129
            END IF
        ELSE IF (LASTTK.EQ.TZEOF) THEN
            CALL ERROR('Attempt To Read Past End-of-File')
        END IF
        IF (SEDDEL) GOTO 100
 
        END
C ----------------------------------------------------------------------
C
C       C A S C V T  -  Convert case of token
C
C
        SUBROUTINE CASCVT(TYPE,LEN,TEXT)
        INTEGER TYPE,LEN,TEXT(1322)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/CASE/KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
        INTEGER KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
 
        SAVE
 
        INTEGER CVT,I
 
        INTEGER ZUPPER
        EXTERNAL ZTOCAP,ZTOLOW,ZUPPER
 
        IF (LEN.EQ.0) THEN
            IF (KWCASE.EQ.1) THEN
                CALL ZTOLOW(TEXT)
            ELSE IF (KWCASE.EQ.2) THEN
                CALL ZTOLOW(TEXT(2))
            END IF
        ELSE IF (TYPE.EQ.TNAME .AND. IDCASE.NE.0 .OR.
     +      TYPE.EQ.TCCNST .AND. STRCAS.NE.0 .OR.
     +      (TYPE.EQ.TFIELD .OR. TYPE.EQ.TSCALE) .AND.
     +           FFCASE.NE.0 .OR.
     +      TYPE.EQ.TCMMNT .AND. CMCASE.NE.0) THEN
            IF (TYPE.EQ.TNAME) CVT=IDCASE
            IF (TYPE.EQ.TCCNST) CVT=STRCAS
            IF (TYPE.EQ.TCMMNT) CVT=CMCASE
            IF (TYPE.EQ.TFIELD .OR. TYPE.EQ.TSCALE) CVT=FFCASE
            IF (CVT.EQ.1) THEN
                CALL ZTOCAP(TEXT)
            ELSE IF (CVT.EQ.2) THEN
                CALL ZTOLOW(TEXT)
            ELSE IF (CVT.EQ.3) THEN
                CALL ZTOLOW(TEXT)
                TEXT(1)=ZUPPER(TEXT(1))
            ELSE
C invertcase
                DO 100 I=1,LEN
                    IF (TEXT(I).GE.65 .AND. TEXT(I).LE.90) THEN
                        TEXT(I)=TEXT(I)-65+97
                    ELSE IF (TEXT(I).GE.97 .AND. TEXT(I).LE.122) THEN
                        TEXT(I)=TEXT(I)-97+65
                    END IF
 100            CONTINUE
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       P R O C M T  -  Process comment/comment-block
C                       (this is not called for single-line comments)
C
 
        SUBROUTINE PROCMT
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
        INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
 
        COMMON/CASE/KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
        INTEGER KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/NAME/PUNAME
        CHARACTER*6 PUNAME
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        SAVE
 
        INTEGER SAVIOD,LEN,BUFF(134),I,MAXLEN,L2
        LOGICAL BOXING
 
        INTEGER ZGTCMD,ZCCTOI
        EXTERNAL SEEK,ZGTCMD,ZPTMES,ZCCTOI
 
        BOXING=CBOX.GT.0 .AND. NXTTYP.EQ.TCMMNT .AND. TOKLEN.GT.0 .AND.
     +         NXTLEN.GT.0
        IF (BOXING .OR. SEQRQD .AND. .NOT. BEGUN) THEN
            BEGCMT=SEQRQD .AND. .NOT. BEGUN
            SAVIOD=IODCUR
            IODCUR=IODSCR
            CALL SEEK(0,IODSCR)
C Output the first line of the comment twice for a whole box, so that we have
C a chance to get the sequence numbering right (for a change!)
            IF (CBOX.EQ.2 .AND. SEQRQD) CALL OUTCMT
 100        CALL OUTCMT
            IF (NXTTYP.EQ.TCMMNT .AND. (NXTLEN.GT.0 .OR. BEGCMT)) THEN
                CALL RDTOK
                GOTO 100
            END IF
            IODCUR=SAVIOD
            IF (BEGCMT) RETURN
        END IF
        BOXING=BOXING .OR. BEGCMT .AND. CBOX.GT.0
        IF (BOXING) THEN
 
C Find the maximum length of all of the comment lines in the block
 
            MAXLEN=0
            CALL SEEK(0,IODSCR)
 200        LEN=ZGTCMD(BUFF,IODSCR)
            IF (LEN.NE.-100) THEN
                L2=MIN(LEN,RMARGC)
C ignore trailing spaces before the sequence number
 250            IF (L2.GT.1 .AND.BUFF(L2).EQ.32) THEN
                    L2=L2-1
                    GOTO 250
                END IF
                IF (L2.GT.MAXLEN) MAXLEN=L2
                GOTO 200
            END IF
        ELSE IF (BEGCMT) THEN
            MAXLEN=0
        END IF
 
C If not enough room for the box, just spew it all back out to IODCUR
C ...ditto if no actual comment test (but no error message).
C ...ditto if unboxed comment at beginning of program unit.
 
        IF (BOXING .OR. BEGCMT) THEN
            IF (MAXLEN.GT.RMARGC-CBOX*2)
     +          CALL PLERR('Comment box exceeds RMARGC - Not added')
            IF (MAXLEN.GT.RMARGC-CBOX*2 .OR. MAXLEN.LE.LMARGC) THEN
                IF (CBOX.EQ.2 .AND. SEQRQD)
     +              CALL PLERR('First line of failed box duplicated')
                CALL SEEK(0,IODSCR)
 300            LEN=ZGTCMD(BUFF,IODSCR)
                IF (LEN.NE.-100) THEN
                    IF (BEGCMT) THEN
                        DO 350 I=1,4
 350                        BUFF(72+I)=ZCCTOI(PUNAME(I:I),BUFF(72+I))
                    END IF
                    CALL ZPTMES(BUFF,IODCUR)
                    GOTO 300
                END IF
                BEGCMT=.FALSE.
                RETURN
            END IF
 
C If we want a whole box, put the top in
 
            IF (CBOX.EQ.2) THEN
                IF (SEQRQD) THEN
                    CALL SEEK(0,IODSCR)
                    LEN=ZGTCMD(BUFF,IODSCR)
                END IF
                IF (CMCHAR.EQ.32) THEN
                    BUFF(1)=67
                    IF (CMCASE.EQ.2) BUFF(1)=99
                ELSE
                    BUFF(1)=CMCHAR
                END IF
                DO 400 I=2,LMARGC-1
 400                BUFF(I)=32
                DO 500 I=LMARGC,MAXLEN+CBOX*2
 500                BUFF(I)=CBTOP
                IF (BEGCMT) THEN
                    DO 550 I=1,4
 550                    BUFF(72+I)=ZCCTOI(PUNAME(I:I),BUFF(72+I))
                ELSE IF (.NOT. SEQRQD) THEN
                    BUFF(MAXLEN+CBOX*2+1)=129
                END IF
                CALL ZPTMES(BUFF,IODCUR)
            END IF
 
C Now do the body of the box
 
            IF (CBOX.NE.2 .OR. .NOT. SEQRQD) CALL SEEK(0,IODSCR)
 600        LEN=ZGTCMD(BUFF,IODSCR)
            IF (LEN.NE.-100) THEN
                DO 700 I=LEN+1,LMARGC,-1
 700                BUFF(I+2)=BUFF(I)
C Don't mess up sequence numbers
                IF (SEQRQD) THEN
                    DO 715 I=73,81
 715                    BUFF(I)=BUFF(I+2)
                END IF
                IF (LEN.LT.LMARGC) THEN
                    DO 725 I=2,LMARGC
 725                    BUFF(I)=32
                    LEN=LMARGC-1
                END IF
                BUFF(LMARGC)=CBSIDE
                BUFF(LMARGC+1)=32
                IF (CBOX.EQ.2) THEN
                    DO 750 I=LEN+3,MAXLEN+3
 750                    BUFF(I)=32
                    BUFF(MAXLEN+4)=CBSIDE
                    IF (.NOT. SEQRQD) BUFF(MAXLEN+5)=129
                END IF
                IF (BEGCMT) THEN
                    DO 775 I=1,4
 775                    BUFF(72+I)=ZCCTOI(PUNAME(I:I),BUFF(72+I))
                END IF
                CALL ZPTMES(BUFF,IODCUR)
                GOTO 600
            END IF
 
C And finally the bottom of the box
 
            IF (CMCHAR.EQ.32) THEN
                BUFF(1)=67
            ELSE
                BUFF(1)=CMCHAR
            END IF
            DO 800 I=2,LMARGC-1
 800            BUFF(I)=32
            DO 900 I=LMARGC,MAXLEN+CBOX*2
 900            BUFF(I)=CBTOP
            IF (SEQRQD) CALL ADDSEQ(BUFF,MAXLEN+CBOX*2+1)
            LNUMBR=LNUMBR+1
            CALL ZPTMES(BUFF,IODCUR)
            BEGCMT=.FALSE.
 
C Otherwise (no funny stuff) just output the comment
 
        ELSE
            CALL OUTCMT
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       A D D S E Q   -   Add a sequence number to a line
C
 
        SUBROUTINE ADDSEQ(LINE,CURSOR)
        INTEGER LINE(*),CURSOR
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/NAME/PUNAME
        CHARACTER*6 PUNAME
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        SAVE
 
        INTEGER I,NDIG
 
        INTEGER ZCCTOI
        EXTERNAL ZCCTOI,ZITOCP
 
        I=INDEX(PUNAME,' ')
        IF (I.GT.0) THEN
            NDIG=MAX(SEQDIG,9-I)
        ELSE
            NDIG=SEQDIG
        END IF
        DO 100 I=CURSOR,72
 100        LINE(I)=32
        DO 200 I=1,MIN(6,8-NDIG)
 200        LINE(72+I)=ZCCTOI(PUNAME(I:I),LINE(72+I))
        DO 300 I=7,8-NDIG
 300        LINE(72+I)=32
        CALL ZITOCP(LNUMBR,LINE(81-NDIG),NDIG,SEQFIL)
        LINE(81)=129
 
        END
C ----------------------------------------------------------------------
C
C       P R O E N D  -  Process END (of program-unit)
C
 
        SUBROUTINE PROEND
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
        INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
        LOGICAL BLADEC
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/MOVFMT/MOVEF,MFFLAG
        LOGICAL MOVEF,MFFLAG
 
        COMMON/NAME/PUNAME
        CHARACTER*6 PUNAME
 
        COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
        LOGICAL DOCONI,IOTHCO
        INTEGER NDOCON,DOCONS(30)
 
        COMMON/DECLUP/DLUP,DLEN,DLUPOS
        LOGICAL DLUP
        INTEGER DLEN,DLUPOS
 
        SAVE
 
        INTEGER LINLEN,BUFF(134)
 
        INTEGER GETLIN
        EXTERNAL GETLIN,PUTLIN,SEEK,ZITOCP
 
        IF (.NOT. BEGUN) THEN
            BEGUN=.TRUE.
            PUNAME='MAIN'
            IF (BEGCMT) CALL PROCMT
        END IF
 
C Output blank line following previous statement if required
 
        IF (BLAFT(LASTST).GT.0) CALL OUTBL
 
C Check for insertion of CONTINUE with labelled END
 
        IF (IOTHCO .AND. LABEL.GT.0) CALL OUTCON
 
C If moving FORMAT statements, output any of them now
 
        IF (MOVEF .AND. MFFLAG) THEN
            CALL SEEK(0,IODFMT)
            LINLEN=GETLIN(BUFF,IODFMT)
            IF (LINLEN.NE.-100) THEN
                IF (BLBEF(TFORMA).GT.0 .AND. LASTST.NE.TCMMNT)CALL OUTBL
                IF (SEQRQD) THEN
                    CALL ZITOCP(LNUMBR,BUFF(77),4,32)
C Replace newline character that ZITOCP overwrote
                    BUFF(81)=10
                END IF
                CALL PUTLIN(BUFF,IODCUR)
                LNUMBR=LNUMBR+SEQINC
 100            LINLEN=GETLIN(BUFF,IODFMT)
                IF (LINLEN.NE.-100) THEN
                    IF (SEQRQD) THEN
                        CALL ZITOCP(LNUMBR,BUFF(77),4,32)
C Replace newline character that ZITOCP overwrote
                        BUFF(81)=10
                    END IF
                    CALL PUTLIN(BUFF,IODCUR)
                    LNUMBR=LNUMBR+SEQINC
                    GOTO 100
                END IF
            END IF
            CALL SEEK(0,IODFMT)
 
C FORMAT statement move finished
 
C If no FORMAT statement moving was done, check for blank line
C outputting before the END.
 
        ELSE IF (BLBEF(TEND).GT.0 .AND. LASTST.NE.TCMMNT) THEN
            CALL OUTBL
        END IF
 
C Process label for END statement if necessary
 
        IF (LABEL.GT.0 .AND..NOT.IOTHCO) CALL PROLBL
 
        IF (DOLVL.GT.0)
     +      CALL PLERR('DO nesting level > 0 at END of Program Unit')
        IF (IFLVL.GT.0)
     +      CALL PLERR('IF nexting level > 0 at END of Program Unit')
        IF (LBLUNK.GT.0)
     +      CALL ERROR('Undefined Labels in Program Unit')
        DOLVL=0
        IFLVL=0
        LBLUNK=0
        CURSOR=LMARGS
        CALL GRIND(TZEOS)
        CALL RDTOK
        LNUMBR=SEQINI
        PUNAME='      '
        LBLTOP=0
        FLBNUM=-1
        SLBNUM=-1
        DLUPOS=0
        MFFLAG=.FALSE.
        BEGUN=.FALSE.
 
        END
C ----------------------------------------------------------------------
C
C       P R O E O S  -  Process End-Of-Statement
C
 
        SUBROUTINE PROEOS
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/CONTIN/CONCHR,CONCNT
        INTEGER CONCHR,CONCNT
 
        SAVE
 
        CONCOL=0
        CONCNT=0
        CALL RDTOK
 
        END
C ----------------------------------------------------------------------
C
C       L E X I S T   -   Label exists?
C
 
        LOGICAL FUNCTION LEXIST(LBL)
        INTEGER LBL
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        INTEGER I
 
        SAVE /STATE/
 
        I=0
 
 100    I=I+1
        IF (I.LT.LBLTOP .AND. LBLTBI(I).NE.LBL) GOTO 100
        LEXIST=LBLTBI(I).EQ.LBL .AND. I.LE.LBLTOP
 
        END
C ----------------------------------------------------------------------
C
C       S E T L B L   -   This routine cheats on the rest of the system.
C                         It sets the value of a label to the next label
C                         which would be output (via SLBNUM/SLBINC)  but
C                         doesn't alter anything else -- so that two
C                         virtual labels will point to the same output
C                         label; this is for when we change our mind
C                         about the target of a GOTO inside a do-loop,
C                         because we thought the do-loop was going to
C                         end on a non-CONTINUE statement, and it
C                         disappointed us.
C
 
        SUBROUTINE SETLBL(LBL)
        INTEGER LBL
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
        INTEGER FLBINI,FLBINC,SLBINI,SLBINC
        LOGICAL RLBFMT,RLBSTM
 
        INTEGER I
 
        SAVE /STATE/,/RELBL/
 
        EXTERNAL ERROR
 
        I=0
 
 100    I=I+1
        IF (I.LT.LBLTOP .AND. LBLTBI(I).NE.LBL) GOTO 100
        IF (LBLTBI(I).NE.LBL) CALL ERROR('SETLBL - Internal Error')
        IF (LBLTBO(I).GT.0) CALL ERROR('SETLBL - Catastrophic Error')
        IF (SLBNUM.GT.0) THEN
            LBLTBO(I)=SLBNUM
        ELSE
            LBLTBO(I)=SLBINI
        END IF
        LBLUNK=LBLUNK-1
 
        END
C ----------------------------------------------------------------------
C
C       P R O E X E  -  Process executable statement.
C                       This actually only does all the label definition
C                       and CONTINUE insertion processing (DO-loop
C                       termination,etc.) and calls PROSTM (ie Process
C                       Statement) which does the statement proper.
C
 
        SUBROUTINE PROEXE
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
        INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
        LOGICAL BLADEC
 
        COMMON/TYPES/ STTYPE
        INTEGER STTYPE(TKLAST)
 
        COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
        LOGICAL DOCONI,IOTHCO
        INTEGER NDOCON,DOCONS(30)
 
        COMMON/NAME/PUNAME
        CHARACTER*6 PUNAME
 
        COMMON/OPT15C/INDDOC,DELSED,BRKLIF
        LOGICAL INDDOC,DELSED,BRKLIF
 
        SAVE
 
        LOGICAL DOCIND,DOTERM
 
C Our own local logical function
        LOGICAL LEXIST
 
        DOCIND=.FALSE.
        DOTERM=.FALSE.
        IF (.NOT. BEGUN) THEN
            BEGUN=.TRUE.
            PUNAME='MAIN'
            IF (BEGCMT) CALL PROCMT
        END IF
 
        IF ((BLBEF(TOKTYP).GT.0 .AND. LASTST.NE.TCMMNT) .OR.
     +      (BLAFT(LASTST).GT.0) .OR.
     +      (STTYPE(LASTST).EQ.3 .AND. BLADEC)) CALL OUTBL
 
C Check for termination of a DO-loop
 
 100    IF (DOLVL.GT.0) THEN
            IF (DOLBL(DOLVL).EQ.LABEL) THEN
C Indent this DO-loop CONTINUE == yes iff we are doing it
                DOCIND=INDDOC
                IF (IOTHCO) DOTERM=.TRUE.
 
C When DOCONI ...
                IF (DOCONI) THEN
C When DOCONI: Output real stmt first if not a CONTINUE
                    IF (TOKTYP.NE.TCONTI) THEN
                        IF (LEXIST(LABEL)) THEN
                            IF (IOTHCO) THEN
                                CALL OUTCON
                            ELSE
                                CALL PROLBL
                            ENDIF
C Restore value of LABEL overwritten by PROLBL
                            LABEL=DOLBL(DOLVL)
                        END IF
                        CALL PROSTM
                    ELSE IF (LEXIST(LABEL)) THEN
C ... For when we had a GOTO to it, and we want the label of the GOTO
C     to actually GOTO it, because it was a CONTINUE after all ...
C ... Call a cheating routine which sets the new value of label painlessly
                        CALL SETLBL(LABEL)
                    END IF
C When DOCONI: If multiple loop term ... output separate CONTINUE(s)
 200                IF (DOLVL.GT.1) THEN
                        IF (DOLBL(DOLVL-1).EQ.LABEL) THEN
                            LABEL=DOCONS(DOLVL)
                            IF (.NOT.DOCIND) DOLVL=DOLVL-1
                            CALL OUTCON
                            IF (DOCIND) DOLVL=DOLVL-1
C Restore value of LABEL overwritten by PROLBL (called by OUTCON)
                            LABEL=DOLBL(DOLVL+1)
                            GOTO 200
                        END IF
                    END IF
C When DOCONI: Finally, replace label with the label we desire
                    LABEL=DOCONS(DOLVL)
                    DOLVL=DOLVL-1
 
C Otherwise (not DOCONI): decrement level and check for nesting
                ELSE
                    DOLVL=DOLVL-1
                    GOTO 100
                END IF
            END IF
        END IF
 
C If we need to output a CONTINUE now (bacause a DO-loop didn't end on
C a CONTINUE), then do it instead of outputting the statement (which
C has been already done).
 
        IF (TOKTYP.EQ.TZEOS) THEN
            IF (DOCIND) DOLVL=DOLVL+1
            CALL OUTCON
            IF (DOCIND) DOLVL=DOLVL-1
        ELSE
 
C Here on all other happenings...
C (When IOTHCO, insert a CONTINUE *before* the current statement)
 
            IF (LABEL.NE.0) THEN
                IF (TOKTYP.EQ.TCONTI .OR. .NOT. IOTHCO) THEN
                    IF (IOTHCO) DOTERM=.FALSE.
                    CALL PROLBL
C If this is a DO loop terminator label then do not insert CONTINUE
                ELSE
                    IF (DOTERM) THEN
                        DOTERM=.FALSE.
                        CALL PROLBL
                    ELSE
                        IF (DOCIND) DOLVL=DOLVL+1
                        CALL OUTCON
                        IF (DOCIND) DOLVL=DOLVL-1
                    ENDIF
                END IF
            END IF
 
C If we have just ended a DO-loop on a CONTINUE and we are supposed to
C indent the CONTINUEs as well, do it.
            IF (DOCIND .AND. TOKTYP.EQ.TCONTI) THEN
                DOLVL=DOLVL+1
                CALL PROSTM
                DOLVL=DOLVL-1
            ELSE
                CALL PROSTM
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       P R O S T M  -  Process (executable) statement.
C                       This processes the statement itself, after any
C                       label processing and CONTINUE insertion has been
C                       done by PROEXE.
C
 
        SUBROUTINE PROSTM
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
        LOGICAL DOCONI,IOTHCO
        INTEGER NDOCON,DOCONS(30)
 
        COMMON/ASGLUP/VLEN
        INTEGER VLEN
 
        COMMON/SPACNG/SPBEF,SPAFT
        INTEGER SPBEF(-2:TKLAST,0:2),SPAFT(-2:TKLAST,0:2)
 
        COMMON/CONTIN/CONCHR,CONCNT
        INTEGER CONCHR,CONCNT
 
        SAVE
 
        INTEGER I
 
        INTEGER CTOI,ITOC
        EXTERNAL CTOI,ITOC
 
        INTRINSIC MIN,MAX
 
        CURSOR=MIN(LMARGS+IFLVL*INDIF+DOLVL*INDDO,MAXIND)
        MINBRK=(CURSOR+RMARGS)/2
100    CONTINUE
C *** This is the point to which the logical IF statement loops back.
        IF (TOKTYP.EQ.TDO) THEN
            IF (DOLVL.EQ.30)
     +          CALL ERROR('DO loops nested too deeply')
            DOLVL=DOLVL+1
            CALL GRIND(TDCNST)
            I=1
            DOLBL(DOLVL)=CTOI(TOKTXT,I)
            IF (DOLBL(DOLVL).EQ.0) CALL PLERR('DO loop has zero label')
 
C If DOCONI (=> RLBSTM), create a new label (negative thus unique)
C In case of multiple loop termination and control-flow references.
 
            DOCONS(DOLVL)=0
            IF (DOCONI) THEN
                NDOCON=NDOCON+1
                DOCONS(DOLVL)=-NDOCON
                TOKLEN=ITOC(-NDOCON,TOKTXT,8)
            END IF
 
            CALL OUTLBL
            CALL SETCON
            IF (TOKTYP.NE.TCOMMA) CURSOR=CURSOR+1
            CALL GRIND(TZEOS)
        ELSE IF (TOKTYP.EQ.TGOTO) THEN
            CALL PROGO
        ELSE IF (TOKTYP.EQ.TIF) THEN
            CALL PROIF
C If a logical IF (not another IF or GOTO) loop back to process it
            IF (TOKTYP.NE.TZEOS) GOTO 100
        ELSE IF (TOKTYP.EQ.TELSE) THEN
            IFLVL=IFLVL-1
            CURSOR=MIN(MAXIND,LMARGS+INDDO*DOLVL+INDIF*IFLVL)
            CALL GRIND1
            IFLVL=IFLVL+1
        ELSE IF (TOKTYP.EQ.TELSIF) THEN
            IFLVL=IFLVL-1
            CURSOR=MIN(MAXIND,LMARGS+INDDO*DOLVL+INDIF*IFLVL)
            CALL PROIF
        ELSE IF (TOKTYP.EQ.TENDIF) THEN
            IFLVL=IFLVL-1
            CURSOR=MIN(MAXIND,LMARGS+INDDO*DOLVL+INDIF*IFLVL)
            CALL GRIND(TZEOS)
        ELSE IF (TOKTYP.EQ.TNAME) THEN
            I=CURSOR
            CALL GRIND(TEQUAL)
            IF (CONCNT.EQ.0 .AND. VLEN.GT.0) THEN
                CURSOR=MAX(CURSOR,I+VLEN)
                IF (SPBEF(TEQUAL,0).GT.0) CURSOR=CURSOR+1
                CURSOR=MIN(CURSOR,RMARGS+1)
            END IF
            CALL GRIND1
            CALL SETCON
            CALL GRIND(TZEOS)
        ELSE IF (TOKTYP.EQ.TREAD .OR. TOKTYP.EQ.TWRITE .OR.
     +           TOKTYP.EQ.TPRINT) THEN
            CALL GRIND1
            IF (TOKTYP.EQ.TDCNST) THEN
                CALL OUTLBL
            ELSE IF (TOKTYP.EQ.TLPARN) THEN
                CALL GRIND1
                IF (TOKTYP.NE.TFMTKD .AND. TOKTYP.NE.TERRKD .AND.
     +              TOKTYP.NE.TENDKD) THEN
 200                CALL GRIND1
                    IF (TOKTYP.NE.TRPARN .AND. TOKTYP.NE.TCOMMA .OR.
     +                  PRNLVL.GT.1) GOTO 200
                    IF (TOKTYP.EQ.TCOMMA) CALL GRIND1
                    IF (TOKTYP.EQ.TDCNST) CALL OUTLBL
                END IF
            END IF
            CALL GRIND(TZEOS)
        ELSE IF (TOKTYP.EQ.TASSIG) THEN
            CALL GRIND(TDCNST)
            CALL OUTLBL
            CALL GRIND(TZEOS)
        ELSE IF (TOKTYP.EQ.TCALL) THEN
            CALL GRIND(TNAME)
            CALL SETCON
            CALL GRIND1
            IF (TOKTYP.EQ.TLPARN) THEN
                CALL GRIND1
                CALL SETCON
            END IF
            CALL GRIND(TZEOS)
        ELSE
            CALL GRIND1
            CALL SETCON
            CALL GRIND(TZEOS)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       P R O F M T  -  Process FORMAT statement
C
 
        SUBROUTINE PROFMT
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
        INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
        LOGICAL BLADEC
 
        COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/MOVFMT/MOVEF,MFFLAG
        LOGICAL MOVEF,MFFLAG
 
        COMMON/NAME/PUNAME
        CHARACTER*6 PUNAME
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        SAVE
 
        INTEGER SAVIOD
 
        IF (.NOT. BEGUN) THEN
            BEGUN=.TRUE.
            PUNAME='MAIN'
            IF (BEGCMT) CALL PROCMT
        END IF
 
        IF (LABEL.GT.0) THEN
            CALL PROLBL
        ELSE
            CALL PLERR('Unlabelled FORMAT statement')
        END IF
        IF (MOVEF) THEN
            SAVIOD=IODCUR
            IODCUR=IODFMT
            MFFLAG=.TRUE.
            CURSOR=LMARGS
        ELSE
            IF ((LASTST.NE.TFORMA .AND. LASTST.NE.TCMMNT) .AND.
     +      (BLBEF(TOKTYP).GT.0 .OR. BLAFT(LASTST).GT.0)) CALL OUTBL
            CURSOR=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,MAXIND)
        END IF
        MINBRK=(CURSOR+RMARGS)/2
        CALL GRIND(TLPARN)
        CALL SETCON
        CALL GRIND(TZEOS)
        IF (MOVEF) THEN
            IODCUR=SAVIOD
            FSTTOK=LASTST
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       P R O D E C  -  Process Declaration
C
 
        SUBROUTINE PRODEC
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
        INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
        LOGICAL BLADEC
 
        COMMON/NAME/PUNAME
        CHARACTER*6 PUNAME
 
        COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
        LOGICAL DOCONI,IOTHCO
        INTEGER NDOCON,DOCONS(30)
 
        COMMON/DECLUP/DLUP,DLEN,DLUPOS
        LOGICAL DLUP
        INTEGER DLEN,DLUPOS
 
        COMMON/TRCOPT/TRACE
        LOGICAL TRACE
 
        SAVE
 
        EXTERNAL ZITOF,ZMESS
 
        IF (BLBEF(TOKTYP).GT.0 .AND. LASTST.NE.TCMMNT .OR.
     +      BLAFT(LASTST).GT.0) CALL OUTBL
        IF (LABEL.GT.0 .AND. .NOT. IOTHCO) CALL PROLBL
        CURSOR=LMARGS
        MINBRK=(CURSOR+RMARGS)/2
C
C First eat type part of declaration if any
C ... or eat the first keyword unless it is a program-unit header
C
        IF (TOKTYP.EQ.TINTEG .OR. TOKTYP.EQ.TREAL .OR.
     +      TOKTYP.EQ.TDOUBL .OR. TOKTYP.EQ.TLOGIC .OR.
     +      TOKTYP.EQ.TCOMPL .OR. TOKTYP.EQ.TCHARA .OR.
     +      TOKTYP.EQ.TDCMPL) THEN
            CALL GRIND1
            IF (TOKTYP.EQ.TSTAR) CALL GRIND1
            IF (TOKTYP.EQ.TLPARN) THEN
C This is where we cheat so that left-parenthesis doesn't output a
C space before it
                LASTTK=TNAME
 100            CALL GRIND(TRPARN)
                IF (PRNLVL.GT.1) GOTO 100
                CALL GRIND1
                IF (LINE(CURSOR-1).NE.32) CURSOR=CURSOR+1
            ELSE IF (TOKTYP.EQ.TDCNST) THEN
                CALL GRIND1
                IF (LINE(CURSOR-1).NE.32) CURSOR=CURSOR+1
            END IF
        ELSE IF (TOKTYP.NE.TPROGR .AND. TOKTYP.NE.TBLOCK .AND.
     +           TOKTYP.NE.TFUNCT .AND. TOKTYP.NE.TSUBRO) THEN
            CALL GRIND1
        END IF
        CALL SETCON
C
C Now check for program unit header
C
        IF (TOKTYP.EQ.TFUNCT .OR. TOKTYP.EQ.TSUBRO .OR. TOKTYP.EQ.TPROGR
     +      .OR. TOKTYP.EQ.TBLOCK) THEN
            IF (NXTTYP.EQ.TZEOS) THEN
                BEGUN=.TRUE.
                IF (BEGCMT) CALL PROCMT
            END IF
            CALL GRIND1
            IF (TOKTYP.EQ.TNAME) THEN
                CALL ZITOF(TOKTXT,1,6,PUNAME,.FALSE.)
                IF (TRACE) CALL ZMESS('Processing '//PUNAME,1)
                BEGUN=.TRUE.
                IF (BEGCMT) CALL PROCMT
                CALL GRIND1
                IF (TOKTYP.EQ.TLPARN) THEN
                    CALL GRIND1
                    CALL SETCON
                    IF (DLUP) DLUPOS=CURSOR
                ELSE IF (TOKTYP.EQ.TZEOS) THEN
                    IF (DLUP) DLUPOS=DLEN+LMARGS
                END IF
            ELSE
                PUNAME='      '
                IF (TRACE)
     +              CALL ZMESS('Processing BLOCK DATA',1)
            END IF
C
C Otherwise, check for funny indenting
C
        ELSE IF (DLUPOS.GT.0) THEN
            CURSOR=MAX(CURSOR,DLUPOS)
            CALL SETCON
        ELSE IF (DLEN.GT.0) THEN
            CURSOR=MAX(CURSOR,LMARGS+DLEN)
            CALL SETCON
        END IF
C
C Check for unnamed main program
C
        IF (.NOT. BEGUN) THEN
            BEGUN=.TRUE.
            PUNAME='MAIN'
            IF (BEGCMT) CALL PROCMT
        END IF
C
C Finally, do special processing for COMMON or standard processing o/w.
C
        IF (FSTTOK.EQ.TCOMMO) THEN
            CALL PROCOM
        ELSE
            CALL GRIND(TZEOS)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C     C O M B L K   -   Process a common block name
C
 
      SUBROUTINE COMBLK
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
      COMMON/COMNAM/COMTXT
      INTEGER COMTXT(1322)
 
      COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
      INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +        NXTTXT(1322)
 
      SAVE
 
      IF (TOKTYP.EQ.TSLASH) THEN
          CALL GRIND1
          IF (TOKTYP.NE.TSLASH) THEN
              CALL SCOPY(TOKTXT,1,COMTXT,1)
          ELSE
              COMTXT(1)=129
          END IF
          CALL GRIND1
      ELSE
          COMTXT(1)=129
      END IF
 
      END
C ----------------------------------------------------------------------
C
C     P R O C O M   -   Process a COMMON statement
C
 
      SUBROUTINE PROCOM
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
      COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
      INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +        NXTTXT(1322)
 
      SAVE
 
      CALL COMBLK
 100  IF (TOKTYP.EQ.TSLASH) THEN
          CALL COMBLK
      ELSE
          CALL GRIND1
      END IF
      IF (TOKTYP.NE.TZEOS) GOTO 100
      CALL GRIND(TZEOS)
 
      END
C ----------------------------------------------------------------------
C
C       P R O L B L  -  Process label at beginning of line
C
 
        SUBROUTINE PROLBL
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/LFORM/LABELF,LABELC
        INTEGER LABELF,LABELC
 
        COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
        INTEGER FLBINI,FLBINC,SLBINI,SLBINC
        LOGICAL RLBFMT,RLBSTM
 
        COMMON/FILES/ TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        INTEGER LBLPAD(2)
 
        SAVE
 
        INTEGER LENLBL,I
 
        INTEGER ITOC,CTOI
        EXTERNAL ITOC,ZITOCP,ERROR,CTOI
 
        DATA LBLPAD/32,48/
 
        IF (LABEL.EQ.0) CALL ERROR('PROLBL called with label=0')
 
C Transform label (and put into table) if relabelling
 
        IF (RLBFMT .OR. RLBSTM) THEN
            I=1
 100        IF (I.LT.LBLTOP .AND. LBLTBI(I).NE.LABEL) THEN
                I=I+1
                GOTO 100
            END IF
            IF (I.LE.LBLTOP .AND. LBLTBI(I).EQ.LABEL) THEN
                IF (LBLTBO(I).GT.0) CALL ERROR('Duplicate labels')
                LBLUNK=LBLUNK-1
            ELSE
                IF (LBLTOP.EQ.500) CALL ERROR('Too many labels')
                LBLTOP=LBLTOP+1
                LBLTBI(LBLTOP)=LABEL
                I=LBLTOP
            END IF
C Initialise SLBNUM/FLBNUM if first time
            IF (SLBNUM.LT.0) THEN
                SLBNUM=SLBINI
                FLBNUM=FLBINI
            END IF
            IF (FSTTOK.EQ.TFORMA .AND. RLBFMT .AND. FLBNUM.GT.0) THEN
                LBLTBO(I)=FLBNUM
                FLBNUM=FLBNUM+FLBINC
            ELSE IF ((FSTTOK.EQ.TFORMA .AND. RLBFMT .AND. FLBNUM.EQ.0)
     +               .OR. (FSTTOK.NE.TFORMA .AND. RLBSTM)) THEN
                LBLTBO(I)=SLBNUM
                SLBNUM=SLBNUM+SLBINC
            ELSE
                LBLTBO(I)=LABEL
            END IF
            LABEL=LBLTBO(I)
            IF (LBLUNK.EQ.0 .AND. IODCUR.EQ.IODRLB) CALL XLATEL
        END IF
 
C At this point we have the (possibly new) label - format & output it
 
        IF (LABELF.EQ.0) THEN
            LENLBL=ITOC(LABEL,LINE(LABELC),7-LABELC)
            LINE(LENLBL+LABELC)=32
        ELSE
            CALL ZITOCP(LABEL,LINE(LABELC),6-LABELC,LBLPAD(LABELF))
            LINE(6)=32
        END IF
        I=1
        IF (LABEL.NE.CTOI(LINE,I)) THEN
            CALL PLERR('Label too big for requested label column')
            LENLBL=ITOC(LABEL,LINE,6)
            LINE(LENLBL+1)=32
        END IF
        CURSOR=7
 
        END
C ----------------------------------------------------------------------
C
C       X L A T E L  -  Translate labels: IODRLB -> IODPOL
C
 
        SUBROUTINE XLATEL
 
        COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/LFORM/LABELF,LABELC
        INTEGER LABELF,LABELC
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        INTEGER FLGSTR(3)
 
        SAVE
 
        INTEGER BUFF(134),STATUS,RESULT,PNTR,LBL,LBTEXT(6),LBLEN,
     +          SHIFT,I
 
        INTEGER GETLIN,ZINDEX,CTOI,ITOC,TYPE
        EXTERNAL GETLIN,PUTLIN,SEEK,ZINDEX,CTOI,ITOC,ZITOCP,TYPE
 
        DATA FLGSTR/35,35,129/
 
        IODCUR=IODPOL
        CALL SEEK(0,IODRLB)
 100    STATUS=GETLIN(BUFF,IODRLB)
        IF (STATUS.EQ.-100) RETURN
 200    RESULT=ZINDEX(BUFF,FLGSTR)
        IF (RESULT.EQ.0 .OR. TYPE(BUFF(RESULT+2)).NE.2) THEN
            CALL PUTLIN(BUFF,IODCUR)
            GOTO 100
        ELSE
            PNTR=RESULT+2
            LBL=LBLTBO(CTOI(BUFF,PNTR))
            IF (LABELF.LE.1) THEN
                LBLEN=ITOC(LBL,LBTEXT,6)
            ELSE
                CALL ZITOCP(LBL,LBTEXT,6-LABELC,48)
                LBLEN=6-LABELC
            END IF
            DO 300 I=1,LBLEN
 300            BUFF(RESULT+I-1)=LBTEXT(I)
            SHIFT=PNTR-(RESULT+LBLEN)
            IF (SHIFT.GT.0) THEN
                IF (SEQRQD) STATUS=71
                DO 400 I=PNTR,STATUS+1
 400                BUFF(I-SHIFT)=BUFF(I)
                STATUS=STATUS-SHIFT
                IF (SEQRQD) THEN
                    DO 500 I=73-SHIFT,72
 500                    BUFF(I)=32
                    STATUS=80
                END IF
            END IF
            GOTO 200
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       P R O G O  -  Process a GO(TO)
C
 
        SUBROUTINE PROGO
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        SAVE
 
C First eat the GOTO
        CALL GRIND1
C Check for the dreaded ASSIGNED GOTO (shock!, horror!!)
        IF (TOKTYP.EQ.TNAME) THEN
            CALL GRIND1
            IF (TOKTYP.NE.TZEOS) THEN
                CALL SETCON
                CALL GRIND(TDCNST)
                CALL OUTLBL
            END IF
        ELSE
            IF (TOKTYP.EQ.TLPARN) THEN
                CALL GRIND1
                CALL SETCON
            END IF
            CALL OUTLBL
        END IF
 100    IF (TOKTYP.EQ.TCOMMA) THEN
            CALL GRIND(TDCNST)
            CALL OUTLBL
            GOTO 100
        END IF
        CALL GRIND(TZEOS)
 
        END
C ----------------------------------------------------------------------
C
C       P R O I F  -  Process an IF statement
C
 
        SUBROUTINE PROIF
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/CONTIN/CONCHR,CONCNT
        INTEGER CONCHR,CONCNT
 
        COMMON/OPT15C/INDDOC,DELSED,BRKLIF
        LOGICAL INDDOC,DELSED,BRKLIF
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        SAVE
 
        CALL GRIND(TLPARN)
        CALL GRIND1
        CALL SETCON
 100    CALL GRIND(TRPARN)
        IF (PRNLVL.GT.1) GOTO 100
        CALL GRIND1
C Must check for the rather different Arithmetic IF
        IF (TOKTYP.EQ.TDCNST) THEN
 200        CALL OUTLBL
            IF (TOKTYP.EQ.TCOMMA) THEN
                CALL GRIND1
                GOTO 200
            END IF
C And now for the dubious Logical IF
        ELSE IF (TOKTYP.NE.TTHEN) THEN
            IF (BRKLIF .AND. CONCNT.EQ.0) THEN
                CONCOL=MIN(LMARGS+DOLVL*INDDO+INDIF*(IFLVL+1),MAXIND)
                CALL BREAK
            END IF
C An Arithmetic IF is allowed on the end of a Logical IF
            IF (TOKTYP.EQ.TIF) GOTO 100
C A GOTO is allowed on the end of a Logical IF
            IF (TOKTYP.EQ.TGOTO) CALL PROGO
C Otherwise:Must be a block IF, hooray
        ELSE
            IFLVL=IFLVL+1
            CALL GRIND(TZEOS)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       O U T L B L  -  Output a label token (inside a statement)
C
 
        SUBROUTINE OUTLBL
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/LFORM/LABELF,LABELC
        INTEGER LABELF,LABELC
 
        COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
        INTEGER FLBINI,FLBINC,SLBINI,SLBINC
        LOGICAL RLBFMT,RLBSTM
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        SAVE
 
        INTEGER I,LBL,LENLBL
 
        INTEGER ITOC,ZSCTOI
        EXTERNAL ITOC,ZITOCP,ZSCTOI,SEEK
 
        I=1
        LBL=ZSCTOI(TOKTXT,I)
        IF (RLBSTM .OR. RLBFMT) THEN
            I=1
 100        IF (I.LT.LBLTOP .AND. LBLTBI(I).NE.LBL) THEN
                I=I+1
                GOTO 100
            END IF
            IF (I.LE.LBLTOP .AND. LBLTBI(I).EQ.LBL) THEN
                LBL=LBLTBO(I)
            ELSE
                LBLUNK=LBLUNK+1
                IF (IODPOL.EQ.IODCUR) THEN
                    IODCUR=IODRLB
                    CALL SEEK(0,IODRLB)
                END IF
                IF (LBLTOP.EQ.500) CALL ERROR('Too many labels')
                LBLTOP=LBLTOP+1
                LBLTBI(LBLTOP)=LBL
                LBLTBO(LBLTOP)=-LBLTOP
                LBL=-LBLTOP
            END IF
        END IF
        IF (LBL.LT.0) THEN
            TOKLEN=5
            CALL ZITOCP(-LBL,TOKTXT(3),3,48)
            TOKTXT(1)=35
            TOKTXT(2)=35
        ELSE IF (LABELF.LE.1) THEN
            TOKLEN=ITOC(LBL,TOKTXT,6)
        ELSE
            CALL ZITOCP(LBL,TOKTXT,6-LABELC,48)
            TOKLEN=6-LABELC
        END IF
        CALL GRIND1
 
        END
C ----------------------------------------------------------------------
C
C       G R I N D  -  Grind the tokens to make the source
C
 
        SUBROUTINE GRIND(ENDTOK)
        INTEGER ENDTOK
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        SAVE
 
C -- Local 2-token lookback, for END=label passed as TENDKD+TEQUAL+TDCNST
        INTEGER PREVTK
 
        PREVTK=0
 100    IF (TOKTYP.EQ.TCMMNT) THEN
            CALL CONLIN
 200        CALL OUTCMT
            PREVTK=LASTTK
            CALL RDTOK
            IF (TOKTYP.EQ.TCMMNT) GOTO 200
        ELSE IF (TOKTYP.EQ.TZEOS) THEN
            RETURN
        ELSE
C Handle label detection: FMT= & END= & ERR=
            IF ((((PREVTK.EQ.TFMTKD .OR. PREVTK.EQ.TERRKD .OR.
     +              PREVTK.EQ.TENDKD) .AND. LASTTK.EQ.TEQUAL) .OR.
C Label detection: also: "(*label" & ",*label" inside a CALL statement
     +          ((PREVTK.EQ.TLPARN .OR. PREVTK.EQ.TCOMMA) .AND.
     +              FSTTOK.EQ.TCALL .AND. LASTTK.EQ.TSTAR))
     +          .AND. TOKTYP.EQ.TDCNST) THEN
                PREVTK=LASTTK
                CALL OUTLBL
            ELSE
                CALL OUTTOK
                IF (TOKTYP.EQ.TLPARN) PRNLVL=PRNLVL+1
                IF (TOKTYP.EQ.TRPARN) PRNLVL=PRNLVL-1
                PREVTK=LASTTK
                CALL RDTOK
            END IF
        END IF
        IF (TOKTYP.EQ.TZEOS) THEN
            IF (PRNLVL.NE.0) CALL PLERR('Unbalanced parentheses')
            IF (ENDTOK.NE.TZEOS) CALL PLERR('Unexpected <TZEOS>')
            CALL OUTPUT
            RETURN
        END IF
        IF (TOKTYP.NE.ENDTOK) GOTO 100
 
        END
C ----------------------------------------------------------------------
C
C       G R I N D 1  -  Grind the current token & step to the next one
C
 
        SUBROUTINE GRIND1
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        SAVE
 
        IF (TOKTYP.EQ.TZEOS) THEN
            CALL PLERR('Internal Error (GRIND1) - TZEOS confusion')
            RETURN
        END IF
        CALL OUTTOK
        IF (TOKTYP.EQ.TRPARN) PRNLVL=PRNLVL-1
        IF (TOKTYP.EQ.TLPARN) PRNLVL=PRNLVL+1
        CALL RDTOK
        IF (TOKTYP.EQ.TCMMNT) THEN
            CALL CONLIN
 100        CALL OUTCMT
            CALL RDTOK
            IF (TOKTYP.EQ.TCMMNT) GOTO 100
        END IF
        IF (TOKTYP.EQ.TZEOS) THEN
            IF (PRNLVL.NE.0) CALL PLERR('Unbalanced parentheses')
            CALL OUTPUT
        END IF
 
        END
C ======================================================================
C
C       T H E     P O L I S H     V I R T U A L     M A C H I N E
C
C ======================================================================
 
C ----------------------------------------------------------------------
C
C       O U T P U T  -  Output the assembled line and clear the buffer
C
 
        SUBROUTINE OUTPUT
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        SAVE
 
        INTEGER I
 
        EXTERNAL ZPTMES
 
  50    IF (CURSOR.GT.1) THEN
            IF (LINE(CURSOR-1).EQ.32) THEN
                CURSOR=CURSOR-1
                GOTO 50
            END IF
        END IF
        IF (SEQRQD .AND. CURSOR.GT.73) THEN
            CALL PLERR('Line too long for Sequence Number')
        ELSE IF (SEQRQD) THEN
            CALL ADDSEQ(LINE,CURSOR)
            CURSOR=81
        END IF
        LINE(CURSOR)=129
        CALL ZPTMES(LINE,IODCUR)
        DO 100 I=1,132
 100        LINE(I)=32
        LINE(132+1)=129
        IF (IODCUR.NE.IODFMT) LNUMBR=LNUMBR+SEQINC
        CURSOR=1
        BRKPOS=0
        BRKPRI=0
 
        END
C ----------------------------------------------------------------------
C
C       O U T T O K  -  Output the current token to the line buffer
C
 
        SUBROUTINE OUTTOK
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TOKEN/ TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/SPACNG/SPBEF,SPAFT
        INTEGER SPBEF(-2:TKLAST,0:2),SPAFT(-2:TKLAST,0:2)
 
        COMMON/STATE/ LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/INTBRK/BRPRIO
        INTEGER BRPRIO(-2:TKLAST,0:2)
 
        COMMON/CVTOPT/CVTHFM,FMSBRK
        LOGICAL CVTHFM,FMSBRK
 
        INTEGER I,SPACEB,SPACEA,PRNIDX,TMP,TLEN
        LOGICAL OQUOTE
 
        SAVE/TOKEN/,/OUTLIN/,/SPACNG/,/STATE/,/MARGIN/,/INTBRK/,/CVTOPT/
 
        EXTERNAL SCOPY,SKIPBL
 
C Token spacing
 
        PRNIDX=PRNLVL
        IF (PRNIDX.GT.2) PRNIDX=2
        IF (PRNIDX.LT.0) PRNIDX=0
        SPACEB=SPBEF(TOKTYP,PRNIDX)
        SPACEA=SPAFT(TOKTYP,PRNIDX)
        IF (SPACEB.EQ.-1) THEN
            SPACEB=1
            IF (LASTTK.EQ.TNAME .OR. LASTTK.EQ.TLPARN) SPACEB=0
        ELSEIF (SPACEB.EQ.-2) THEN
            CALL PLERR('Wrong paren level for token')
        ENDIF
        IF (SPACEB.GT.0 .AND. LINE(CURSOR-1).EQ.32) SPACEB=SPACEB-1
        IF (SPACEA.EQ.-1) THEN
            SPACEA=1
            IF (NXTTYP.EQ.TRPARN .OR. NXTTYP.EQ.TCOMMA) SPACEA=0
C TLE..TCNCAT  =  all operators bar assignment
            IF (NXTTYP.GE.TLE .AND. NXTTYP.LE.TCNCAT .OR.
     +          NXTTYP.EQ.TEQUAL) SPACEA=0
        ELSE IF (SPACEA.EQ.-3) THEN
            IF (NXTTYP.EQ.TSTAR) THEN
                SPACEA=0
            ELSE
                SPACEA=1
            END IF
        END IF
 100    IF (FSTTOK.EQ.TFORMA .AND. TOKTYP.EQ.TCCNST .AND.
     +      SPACEB+TOKLEN+CURSOR-1.GT.RMARGS .AND.
     +      TOKLEN.GT.4 .AND. FMSBRK) THEN
C Long string inside FORMAT - break it and put a comma between.
            SPACEA=MAX(SPACEA,SPBEF(TCOMMA,PRNIDX))
            TLEN=RMARGS-CURSOR-SPACEB-SPACEA
            IF (TLEN.LT.4) GOTO 300
            IF (TOKTXT(TLEN).EQ.39) THEN
                OQUOTE=.TRUE.
                I=TLEN-1
 200            IF (TOKTXT(I).EQ.39) OQUOTE=.NOT.OQUOTE
                I=I-1
                IF (I.GE.1) GOTO 200
                IF (OQUOTE) TLEN=TLEN-1
            END IF
            IF (TLEN.LT.4) GOTO 300
            TMP=TOKTXT(TLEN)
            TOKTXT(TLEN)=129
            CURSOR=CURSOR+SPACEB
            CALL SCOPY(TOKTXT,1,LINE,CURSOR)
            CURSOR=CURSOR+TLEN-1
            LINE(CURSOR)=39
            CURSOR=CURSOR+1+SPACEA
            LINE(CURSOR)=44
            CURSOR=CURSOR+1
            TOKTXT(TLEN)=TMP
            CALL SCOPY(TOKTXT,TLEN,TOKTXT,2)
            TOKLEN=TOKLEN-(TLEN-2)
            CALL CONLIN
            SPACEA=SPAFT(TCCNST,PRNIDX)
            GOTO 100
        END IF
 300    IF (SPACEB+TOKLEN+CURSOR-1.GT.RMARGS) THEN
            CALL BREAK
C Preserve spacing (if room on line and other tokens preceding...)
            IF (SPACEB+TOKLEN+CURSOR-1.LE.RMARGS) THEN
                I=7
                CALL SKIPBL(LINE,I)
                IF (LINE(I).NE.32) CURSOR=CURSOR+SPACEB
            END IF
        ELSE
            CURSOR=CURSOR+SPACEB
        END IF
        CALL SCOPY(TOKTXT,1,LINE,CURSOR)
C erase spurious eos
        LINE(CURSOR+TOKLEN)=32
        CURSOR=CURSOR+TOKLEN+SPACEA
        IF (BRPRIO(TOKTYP,PRNIDX).GE.BRKPRI .AND. CURSOR.GE.MINBRK) THEN
            BRKPOS=CURSOR
            BRKPRI=BRPRIO(TOKTYP,PRNIDX)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       O U T C M T  -  Output the current (comment) token, preserving
C                       the currently partially assembled line buffer.
C
 
        SUBROUTINE OUTCMT
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/STATE/ LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
        INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
        LOGICAL BLADEC
 
        COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
        INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
 
        SAVE
 
        INTEGER BUFF(134),POS,I,START,CMTLEN
 
        INTEGER LENGTH
        EXTERNAL ZPTMES,SKIPBL,LENGTH
 
C If comments are "verbatim", output it and return
 
        IF (CMMODE.EQ.2) THEN
C .. but add a sequence number if necessary
            IF (SEQRQD) CALL ADDSEQ(TOKTXT,LENGTH(TOKTXT)+1)
            CALL ZPTMES(TOKTXT,IODCUR)
            RETURN
        END IF
 
        IF (TOKTXT(1).NE.32 .AND. TOKLEN.GT.0) THEN
C A real comment line -- marginise and (optionally) indent it
            BUFF(1)=TOKTXT(1)
            IF (CMCHAR.NE.32) BUFF(1)=CMCHAR
C Work out where to put the comment text on the line
            START=LMARGC
            IF (INDCMT) START=MIN(LMARGS+DOLVL*INDDO+IFLVL*INDIF,MAXIND)
            I=2
            CALL SKIPBL(TOKTXT,I)
C If leading spaces past START are significant, don't skip them
            IF (CMMODE.NE.1 .AND. I.GT.START) I=START
            IF (TOKTXT(I).EQ.129) THEN
C A comment line with nothing on it -- Output it as is
                BUFF(2)=129
            ELSE
                CMTLEN=LENGTH(TOKTXT(I))
C If it is too long, try to fit it on anyhow
                IF (START+CMTLEN-1.GT.RMARGC) THEN
                    START=MAX(2,RMARGC-CMTLEN+1)
                    IF (START+CMTLEN-1.GT.MAX(RMARGC,72)) THEN
                        CALL PLERR('Comment line too long')
                    ELSE IF (START+CMTLEN-1.GT.RMARGC) THEN
                        CALL PLERR('Comment line exceeds margin')
                    ELSE
                        CALL PLERR('Can''t indent comment line')
                    END IF
                END IF
C Indent it with leading spaces
                DO 100 POS=2,START-1
 100                BUFF(POS)=32
C And copy it into the buffer together with the <eos>
                DO 200 POS=I,TOKLEN+1
 200                BUFF(POS-I+START)=TOKTXT(POS)
            END IF
        ELSE
C A blank comment line -- just output it as a blank line
            BUFF(1)=BLCHAR
            BUFF(2)=129
        END IF
        IF (SEQRQD) THEN
            CALL ADDSEQ(BUFF,LENGTH(BUFF)+1)
        END IF
        CALL ZPTMES(BUFF,IODCUR)
        LNUMBR=LNUMBR+SEQINC
 
        END
C ----------------------------------------------------------------------
C
C       B R E A K  -  Break a line which is about to be too long
C
 
        SUBROUTINE BREAK
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        SAVE
 
        INTEGER NEWLIN(1322),PNTR,CONPOS,SAVEPL
        LOGICAL OUTCC
 
        EXTERNAL SKIPBL,SCOPY
 
        IF (CONCOL.GT.0 .AND. INDCON.LT.0) THEN
            CONPOS=CONCOL
        ELSE
            CONPOS=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,MAXIND)+
     +             ABS(INDCON)
        END IF
        IF (TOKLEN+CONPOS+CURSOR-BRKPOS.GT.RMARGS) BRKPOS=0
 
C Ok, here we go...
        IF (BRKPOS.EQ.0) THEN
            CALL CONLIN
C Extraordinary measures for big tokens
 100        IF (TOKLEN+CURSOR-1.GT.RMARGS) THEN
 
                IF (TOKLEN+6.GT.RMARGS .AND. RMARGS.LT.72)
     +              CALL PLERR('Token extends past RMARGS - n'//
     +                         'ot truncated o'//'r split')
C If it is really enormous, overflow it to the next con. line as well
                IF (TOKLEN+6.GT.72) THEN
                    CALL SCOPY(TOKTXT,67,NEWLIN,1)
                    TOKTXT(67)=129
                    CALL SCOPY(TOKTXT,1,LINE,7)
                    CURSOR=73
                    CALL CONLIN
                    CURSOR=7
                    TOKLEN=TOKLEN-66
                    CALL SCOPY(NEWLIN,1,TOKTXT,1)
C Loop back in case token is *REALLY* big
                    GOTO 100
 
C Not enormous, just big -- so make it fit (just) onto this line
                ELSE IF (TOKLEN+6.GT.RMARGS) THEN
                    CURSOR=7
                ELSE
                    CURSOR=RMARGS-TOKLEN+1
                END IF
            END IF
 
C Line break position is ok, so just do it
        ELSE
            PNTR=BRKPOS
            LINE(CURSOR)=129
            CALL SKIPBL(LINE,PNTR)
            CALL SCOPY(LINE,PNTR,NEWLIN,1)
            CURSOR=BRKPOS
            OUTCC=.TRUE.
            SAVEPL=PRNLVL
            DO 200 PNTR=BRKPOS,80
                IF (LINE(PNTR).EQ.39) THEN
                    OUTCC=.NOT.OUTCC
                ELSE IF (OUTCC .AND. LINE(PNTR).EQ.40) THEN
                    PRNLVL=PRNLVL-1
                ELSE IF (OUTCC .AND. LINE(PNTR).EQ.41) THEN
                    PRNLVL=PRNLVL+1
                END IF
 200            LINE(PNTR)=32
            CALL CONLIN
            PRNLVL=SAVEPL
            MINBRK=(CURSOR+RMARGS)/2
            CALL SCOPY(NEWLIN,1,LINE,CURSOR)
 300        IF (LINE(CURSOR).NE.129) THEN
                CURSOR=CURSOR+1
                GOTO 300
            END IF
            LINE(CURSOR)=32
            BRKPRI=0
            BRKPOS=0
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       C O N L I N  -  Make a Continuation to the current Line.
C                       Usually just writes the current line and sets up
C                       a continuation line, but can sometimes break a
C                       statement into 2 or more if the maximum number
C                       of continuation lines is exceeded.
C
 
        SUBROUTINE CONLIN
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/CONTIN/CONCHR,CONCNT
        INTEGER CONCHR,CONCNT
 
        COMMON/STATE/ LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/COMNAM/COMTXT
        INTEGER COMTXT(1322)
 
        INTEGER CON(3,19),TEXT(134),DUMMY(2),I
 
        SAVE
 
        INTRINSIC ABS
 
        INTEGER ZTOKTX,LENGTH
        EXTERNAL ZTOKTX,LENGTH,SCOPY
 
        DATA DUMMY/129,129/
 
C *********CONCHR.EQ.1 => Numeric
C          CONCHR.EQ.2 => Alphabetic
C          CONCHR.EQ.3 => Numeric then Alphabetic
 
        DATA (CON(1,I),I=1,19)/49,50,51,52,53,54,55,
     +          56,57,49,50,51,52,53,54,55,56,
     +          57,49/
        DATA (CON(2,I),I=1,19)/65,66,67,68,69,70,71,
     +          72,73,74,75,76,77,78,79,80,81,
     +          82,83/
        DATA (CON(3,I),I=1,19)/49,50,51,52,53,54,55,
     +          56,57,65,66,67,68,69,70,71,72,
     +          73,74/
 
        IF (CONCNT.EQ.19 .AND. PRNLVL.EQ.0 .AND.
     +      (FSTTOK.EQ.TINTEG .OR. FSTTOK.EQ.TLOGIC .OR.
     +       FSTTOK.EQ.TDOUBL .OR. FSTTOK.EQ.TCOMPL .OR.
     +       FSTTOK.EQ.TCHARA .OR. FSTTOK.EQ.TREAL) .AND.
     +       LINE(CURSOR-1).EQ.44) THEN
            CURSOR=CURSOR-1
            LINE(CURSOR)=32
            CALL OUTPUT
            IF (ZTOKTX(FSTTOK,0,DUMMY,TEXT).NE.-2)
     +          CALL ERROR('UNEXPECTED ZTOKTX FAILURE')
            CONCNT=0
            CURSOR=LMARGS
            MINBRK=(CURSOR+RMARGS)/2
            CALL SCOPY(TEXT,1,LINE,CURSOR)
            CURSOR=CURSOR+LENGTH(TEXT)
        ELSE IF (CONCNT.EQ.19 .AND. PRNLVL.EQ.0 .AND. FSTTOK.EQ.TCOMMO
     +           .AND. LINE(CURSOR-1).EQ.44) THEN
            CURSOR=CURSOR-1
            LINE(CURSOR)=32
            CALL OUTPUT
            IF (ZTOKTX(FSTTOK,0,DUMMY,TEXT).NE.-2)
     +          CALL ERROR('CONLIN: UNEXPECTED ZTOKTX FAILURE 2')
            CONCNT=0
            CURSOR=LMARGS
            MINBRK=(CURSOR+RMARGS)/2
            CALL SCOPY(TEXT,1,LINE,CURSOR)
            CURSOR=CURSOR+LENGTH(TEXT)
            LINE(CURSOR)=47
            CURSOR=CURSOR+1
            DO 100 I=1,LENGTH(COMTXT)
                LINE(CURSOR)=COMTXT(I)
                CURSOR=CURSOR+1
                IF (CURSOR.GT.RMARGS) THEN
                    CALL OUTPUT
                    CONCNT=CONCNT+1
                    IF (CONCHR.LE.32) THEN
                        LINE(6)=CON(CONCHR,CONCNT)
                    ELSE
                        LINE(6)=CONCHR
                    END IF
                    IF (INDCON.GE.0 .OR. CONCOL.EQ.0) THEN
                        CURSOR=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,
     +                             MAXIND)+ABS(INDCON)
                    ELSE
                        CURSOR=CONCOL
                    END IF
                END IF
 100        CONTINUE
            LINE(CURSOR)=47
            CURSOR=CURSOR+1
            IF (CURSOR.GT.RMARGS)
     +          CALL ERROR('COMMON SPLITTING FAILED')
        ELSE
            CALL OUTPUT
            CONCNT=CONCNT+1
            IF (CONCNT.GT.19) THEN
                CALL PLERR('Too many continuation lines generated')
                CONCNT=1
            END IF
            IF (CONCHR.LE.32) THEN
                LINE(6)=CON(CONCHR,CONCNT)
            ELSE
                LINE(6)=CONCHR
            END IF
            IF (INDCON.GE.0 .OR. CONCOL.EQ.0) THEN
                CURSOR=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,MAXIND)+
     +                 ABS(INDCON)
            ELSE
                CURSOR=CONCOL
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       O U T B L  -  Output a Blank Line
C
 
        SUBROUTINE OUTBL
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
        INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
        LOGICAL BLADEC
 
        COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/NAME/ PUNAME
        CHARACTER*6 PUNAME
 
        INTEGER BUFF(134),PTR
 
        SAVE
 
        EXTERNAL PUTCH,ZOBLNK,ZCHOUT,ZPTINT
 
        BUFF(1)=BLCHAR
        BUFF(2)=129
        PTR=2
        IF (SEQRQD) CALL ADDSEQ(BUFF,PTR)
        CALL ZPTMES(BUFF,IODCUR)
        LNUMBR=LNUMBR+SEQINC
        LASTST=TCMMNT
 
        END
C ----------------------------------------------------------------------
C
C       O U T C O N  -  Output a "CONTINUE" (line must have a label)
C
 
        SUBROUTINE OUTCON
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/TOKEN/TOKTYP,TOKLEN,TOKTXT,NXTTYP,NXTLEN,NXTTXT
        INTEGER TOKTYP,TOKLEN,TOKTXT(1322),NXTTYP,NXTLEN,
     +          NXTTXT(1322)
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
        INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
        LOGICAL BLADEC
 
        SAVE /MARGIN/,/TOKEN/,/STATE/,/OUTLIN/,/INDENT/,/BLINES/
 
        INTEGER SAVTYP,SAVLEN,SAVTXT(1322),TMPTXT(2),JUNK
 
        INTEGER ZTOKTX
        EXTERNAL SCOPY,ZTOKTX
 
        IF (BLBEF(TCONTI).GT.0 .AND. LASTST.NE.TCMMNT) CALL OUTBL
        CALL PROLBL
 
        SAVTYP=TOKTYP
        SAVLEN=TOKLEN
        IF (TOKLEN.GT.0) CALL SCOPY(TOKTXT,1,SAVTXT,1)
        TOKTYP=TCONTI
        TOKLEN=0
        TMPTXT(1)=129
        JUNK=ZTOKTX(TOKTYP,TOKLEN,TMPTXT,TOKTXT)
        CALL CASCVT(TOKTYP,TOKLEN,TOKTXT)
        TOKLEN=8
        TOKTXT(9)=129
        CURSOR=MIN(LMARGS+INDDO*DOLVL+INDIF*IFLVL,MAXIND)
        CALL OUTTOK
        CALL OUTPUT
        TOKTYP=SAVTYP
        TOKLEN=SAVLEN
        IF (SAVLEN.GT.0) CALL SCOPY(SAVTXT,1,TOKTXT,1)
        LASTST=TCONTI
 
        END
C ----------------------------------------------------------------------
C
C       S E T C O N   -   Set continuation point
C
 
        SUBROUTINE SETCON
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/DECLUP/DLUP,DLEN,DLUPOS
        LOGICAL DLUP
        INTEGER DLEN,DLUPOS
 
        COMMON/TYPES/ STTYPE
        INTEGER STTYPE(TKLAST)
 
        COMMON/OUTLIN/LINE,CURSOR
        INTEGER LINE(134),CURSOR
 
        SAVE
 
C Make sure we don't line up a continuation line further than half-way
C along that portion of the line we are using (or, for the DLUP feature,
C more that 2/3rds of the way along the line of a declarative statement)
        IF (DLUP .AND. STTYPE(FSTTOK).EQ.3) THEN
            IF (CURSOR.LE.(LMARGS+2*RMARGS)/3) CONCOL=CURSOR
        ELSE IF (CURSOR.LE.(LMARGS+INDDO*DOLVL+INDIF*IFLVL+RMARGS)/2)
     +  THEN
            CONCOL=CURSOR
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       P L E R R  -  Output a PL error message to both err & o/p files
C
 
        SUBROUTINE PLERR(ERRTXT)
        CHARACTER*(*) ERRTXT
 
        COMMON/FILES/TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
        INTEGER TKDESC,IODPOL,IODRLB,IODCUR,IODFMT,IODSCR
 
        COMMON/STATE/LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,
     +          IFLVL,DOLBL,BRKPOS,BRKPRI,MINBRK,LNUMBR,BEGCMT,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI,LBLTBO,LBLTOP,BEGUN
        INTEGER LABEL,FSTTOK,LASTST,PRNLVL,LASTTK,CONCOL,DOLVL,IFLVL,
     +          DOLBL(30),BRKPOS,BRKPRI,MINBRK,LNUMBR,
     +          FLBNUM,SLBNUM,LBLUNK,LBLTBI(500)
     +          ,LBLTBO(500),LBLTOP
        LOGICAL BEGUN,BEGCMT
 
        COMMON/ERTEST/NERROR
        INTEGER NERROR
 
        COMMON/NAME/PUNAME
        CHARACTER*6 PUNAME
 
        COMMON/ERROPT/ERRCMT
        LOGICAL ERRCMT
 
        SAVE
 
        INTEGER ILN(5),I,ERRLEN
        CHARACTER JUNK
        CHARACTER*4 LN
        CHARACTER*134 ERRMSG
 
        INTRINSIC LEN
 
        CHARACTER ZCITOC
        EXTERNAL REMARK,ZMESS,ZITOCP,ZCITOC
 
        ERRLEN=LEN(ERRTXT)
        CALL ZITOCP(LNUMBR,ILN,4,32)
        DO 100 I=1,4
 100        JUNK=ZCITOC(ILN(I),LN(I:I))
        ERRMSG='Line '//LN//', '//PUNAME//': '//ERRTXT
        CALL REMARK(ERRMSG(1:ERRLEN+19))
        IF (ERRCMT) THEN
            ERRMSG='C*PL*ERROR* '//ERRTXT
            CALL ZMESS(ERRMSG(1:ERRLEN+12),IODCUR)
        END IF
        NERROR=NERROR+1
 
        END
C ----------------------------------------------------------------------
C
C       Z P L E R R   -   Return number of errors discovered by polish
C
 
        INTEGER FUNCTION ZPLERR()
 
        COMMON/ERTEST/NERROR
        INTEGER NERROR
 
        SAVE
 
        ZPLERR=NERROR
 
        END
